Just Call Me Internet/Just Call Me Internet.iso/prog/atari/m2/cat3src/magic/i/mtcomman.i

Modula Implementation | 1997-10-26 | 7.6 KB | 247 lines

(*----------------------------------------------------------------------*
 *                                                                      *
 *  MAGICTOOLS   Modula's  All purpose  GEM  Interface  Cadre  Toolbox  *
 *               ÿ         ÿ            ÿ    ÿ          ÿ               *
 *----------------------------------------------------------------------*
 * Version 3.30  02.02.1992     (C)90/91/92 by Peter Hellinger Software *
 *----------------------------------------------------------------------*
 *            Dieses Modul ist urheberrechtlich geschtzt.              *
 *                                                                      *
 * Die Ver”ffentlichung des Quelltextes oder Teilen daraus, sowie die   *
 * Verbreitung des bersetzten, nicht gelinkten Codes in schriftlicher, *
 * oder maschinenlesbarer Form, insbesondere in Zeitschriften, Mail-    *
 * boxen oder anderen Medien bedarf der ausdrcklichen schriftlichen    *
 * Einverst„ndnisserkl„rung des Autors.                                 *
 *                                                                      *
 * Die Verbreitung des Moduls als Teil eines gelinkten Programms ist    *
 * fr Lizenznehmer ausdrcklich erlaubt!  Der Autor beh„lt sich das    *
 * Recht vor, diese Erlaubnis jederzeit und ohne Angaben von Grnden zu *
 * widerrufen.                                                          *
 *----------------------------------------------------------------------*)

IMPLEMENTATION MODULE mtCommand;

(*----------------------------------------------------------------------*
 * Int. Vers | Datum    | Name | Žnderung                               *
 *-----------+----------+------+----------------------------------------*
 *  3.00     | 18.01.92 |  Hp  |                                        *
 *-----------+----------+------+----------------------------------------*)


(* IMPLEMENTATION FšR  >>> Megamax-Modula-2 <<< *)
(*                                              *)
(*$R-   Range-Checks                            *)
(*$S-   Stack-Check                             *)
(*                                              *)
(*----------------------------------------------*)






FROM MagicSys   IMPORT  Nil, Null, Bit0, Bit1, Bit2, Bit3, Bit4, Bit5, Bit6,
                        Bit7, Bit8, Bit9, Bit10, Bit11, Bit12, Bit13, Bit14,
                        Bit15, LOC, Byte, ByteSet, sWORD, sINTEGER, sCARDINAL,
                        sBITSET, lINTEGER, lCARDINAL, lWORD, lBITSET,
                        CastToChar, CastToByte, CastToByteset, CastToInt,
                        CastToCard, CastToBitset, CastToWord, CastToLInt,
                        CastToLCard, CastToLBitset, CastToLWord, CastToAddr,
                        TosVersion, Accessory, Basepage, SysHeader, TosDate;






FROM SYSTEM     IMPORT  ADDRESS, ADR, BYTE, TSIZE;
FROM MagicStrings  IMPORT  Append, Assign, Length, Pos, Delete;
IMPORT  MagicTypes;

(*----------------------------------------------------------------------*)

VAR     pCount:   sCARDINAL;
        BasePage: MagicTypes.PtrPD;
        Argv:     BOOLEAN;
        arg:      sCARDINAL; (* Pos. des ersten Arg. in Environment *)
        env:      POINTER TO ARRAY [0..MAX (CARDINAL)] OF CHAR;
        path:     ARRAY [0..255] OF CHAR;
        init:     sCARDINAL;


PROCEDURE ArgV (): BOOLEAN;
BEGIN
 RETURN Argv;
END ArgV;

PROCEDURE ParamCount (): sINTEGER;
BEGIN
 RETURN pCount;
END ParamCount;

PROCEDURE EnvLine (n, pos: sINTEGER; VAR line: ARRAY OF CHAR): BOOLEAN;
VAR (*$Reg*)  l: sCARDINAL;
    (*$Reg*)  d: sCARDINAL;
    (*$Reg*)  x: sCARDINAL;
    p: sINTEGER;
BEGIN
 IF BasePage^.pEnv # Null THEN
  env:= BasePage^.pEnv;  x:= pos;  p:= 0;  d:= 0;  l:= HIGH (line);
  LOOP
   IF p = n THEN
    WHILE (env^[x] # 0C) AND (d < l) DO
     line[d]:= env^[x];  INC (x);  INC (d);
    END; (* WHILE *)
    line[d]:= 0C;
    RETURN TRUE;
   END;
   IF (env^[x] = 0C) THEN
    IF (env^[x + 1] = 0C) THEN
     (* Doppelnull, fertisch *)  RETURN FALSE;
    END;
    INC (p);
   END;
   INC (x);
  END;
 END;
 RETURN FALSE;
END EnvLine;

PROCEDURE ParamString (n: sINTEGER; VAR argument: ARRAY OF CHAR);
VAR (*$Reg*)  c: sCARDINAL;
    (*$Reg*)  d: sCARDINAL;
    (*$Reg*)  x: sCARDINAL;
    l: sCARDINAL;
    p: sINTEGER;
    b: BOOLEAN;
BEGIN
 argument[0]:= 0C;
 IF Argv THEN (* Parameter im Environment *)
  IF n = 0 THEN (* argv0 liefern, daž ist der Programmpfad! *)
   Assign (path, argument);
  ELSIF n > 0 THEN
   b:= EnvLine (n - 1, arg, argument);
  END;
 ELSE (* Kein Argv, Parameter in der Kommandozeile *)
  IF n > 0 THEN
   p:= 1;  c:= 1;  l:= ORD(BasePage^.pCmdlin[0]);
   LOOP
    IF n = p THEN
     d:= 0;  DEC (c);  IF c = 0 THEN c:= 1; END;
     WITH BasePage^ DO
      WHILE (pCmdlin[c] # 0C) AND (pCmdlin[c] # ' ') AND (c <= 126) DO
       argument[d]:= pCmdlin[c];  INC (c);  INC (d);
      END;
     END;
     argument[d]:= 0C;
     RETURN
    END;
    IF (c = l) OR (c > 126) THEN  EXIT  END;
    IF (BasePage^.pCmdlin[c] = ' ') THEN
     INC (p);  WHILE (BasePage^.pCmdlin[c] = ' ') DO  INC (c);  END;
    END;
    INC (c);
   END;
  END;
 END;
END ParamString;

PROCEDURE EnvVar (REF name: ARRAY OF CHAR; VAR value: ARRAY OF CHAR): BOOLEAN;
VAR b: BOOLEAN;
    i: sINTEGER;
    c: sCARDINAL;
    n: ARRAY [0..255] OF CHAR;
    str: ARRAY [0..255] OF CHAR;
BEGIN
 i:= 0;  str[0]:= 0C;  value[0]:= 0C;
 Assign (name, n);
 IF n[LENGTH(n)-1] # '=' THEN Append ('=', n); END;
 REPEAT
  b:= EnvLine (i, 0, str);
  IF b THEN
   c:= Pos (n, str, 0, n[0] = '*');
   IF c < SIZE (str) THEN
    Delete (str, c, Length(n));
    Assign (str, value);
    RETURN TRUE;
   END;
  END;
  INC (i);
 UNTIL b = FALSE;
 RETURN FALSE;
END EnvVar;

PROCEDURE Init;
VAR (*$Reg*) v: sCARDINAL; (* Counter durchs Environment *)
    (*$Reg*) x: sCARDINAL;
    (*$Reg*) c: sCARDINAL;
    l: sCARDINAL;
BEGIN
 IF init # 30961 THEN
  Argv:= FALSE;  pCount:= 0;  arg:= 0;

  (* Basepage auslesen *)
  BasePage:= Basepage ();
  l:= ORD(BasePage^.pCmdlin[0]);
  IF l = 127 THEN
   env:= BasePage^.pEnv;
   (* 'ARGV=' suchen *)
   v:= 0;
   LOOP
    IF (env^[v] = 0C) AND (env^[v + 1] = 0C) THEN  EXIT;  END;
    Argv:= (env^[v    ] = 'A') AND
           (env^[v + 1] = 'R') AND
           (env^[v + 2] = 'G') AND
           (env^[v + 3] = 'V') AND
           (env^[v + 4] = '=');
    IF Argv THEN  env^[v]:= 0C;  INC (v, 5);  EXIT;  END;
    INC (v);
   END; (* LOOP *)
  END;

  IF Argv THEN
   (* Nach erstem Null-Char suchen, v zeigt auf das Zeichen nach 'ARGV=' *)
   WHILE env^[v] # 0C DO  INC (v);  END;
   INC (v); (* Erstes Zeichen des folgenden Parameters *)

   (* Hier beginnt der erste Parameter. Das ist der Name und Pfad unter
    * der das Programm gestartet wurde...
    *)
   x:= 0;
   WHILE (env^[v] # 0C) AND (x < 255) DO
    path[x]:= env^[v];  INC (v);  INC (x);
   END;
   path[x]:= 0C;

   arg:= v + 1; (* Position des ersten Arguments im Environment *)
   pCount:= 0; (* Argumentz„hler l”schen *)
   LOOP
    INC (v);
    IF env^[v] = 0C THEN (* Doppelnull, fertisch *)  EXIT;  END;
    INC (pCount);
    WHILE env^[v] # 0C DO  INC (v); END;
   END;

  ELSE (* Kein ARGV, Parameter aus der Basepage holen *)
   IF (l > 0) THEN
    pCount:= 1;  c:= 1;
    LOOP
     IF c = l THEN  EXIT;  END;
     IF (BasePage^.pCmdlin[c] = ' ') THEN
      INC (pCount);
      WHILE (BasePage^.pCmdlin[c] = ' ') DO  INC (c);  END;
     END;
     INC (c);
    END;
   ELSE
    pCount:= 0;
   END;
  END;
  init:= 30961;
 END;
END Init;

BEGIN
 init:= 0;  Init;
END mtCommand.